'  SCHEDULE.BAS - contains all the main scheduling functions.

Option Explicit
Option Compare Text

Sub DoResUpdate (dtAsOf As Variant)

  
   ReDim autInfo(0) As utRowRec
   Dim nRtn As Integer
   Dim i As Integer
   Dim nTID As Integer
   Dim nAUID As Integer
   Dim nActWork As Integer
   Dim nRemWork As Integer
   Dim nAddWork As Integer
   Dim dtResStart As Variant
   Dim dtResFinish As Variant
   Dim bResult As Integer
   Dim nETC As Integer, nWrk As Integer
   Dim oTAssign As Object

   On Error GoTo DoResUpdateError
   Screen.MousePointer = HOURGLASS

   nRtn = GetGridInfo(autInfo()) ' nRtn is the count of rows placed into the autInfo array.
   If nRtn <= 0 Then
      ' grid was empty or an error occured
   Else
      For i = 1 To nRtn - 1
         ' Get the task id and assignment id, then set the current assignment object.
         nTID = autInfo(i).nTID
         nAUID = autInfo(i).nAUID
         Set oTAssign = goActiveProj.Tasks(nTID).Assignments

         ' If START is dirty then actual work was 0 and the user entered
         'a resource start date.
         If autInfo(i).bStartDirty Then
            dtResStart = autInfo(i).dtStart
            ' Adjust the resource start to match the start entered by the
            'user.
            bResult = UpdateResourceStart(oTAssign, nTID, nAUID, dtResStart)

            ' The user may also have entered additional hours or changed ETC.
            If autInfo(i).bAddWorkDirty Or autInfo(i).bETCDirty Then
               nActWork = autInfo(i).nActWork + autInfo(i).nAddWork
               nAddWork = autInfo(i).nAddWork
               nRemWork = autInfo(i).nETC
               ' Update resource work.
               bResult = UpdateResourceWork(oTAssign, nTID, nAUID, nActWork, nAddWork, nRemWork, dtAsOf)
            End If
         End If

         ' If ADDHOURS or ETC are dirty, then the user has changed some
         'aspect of resource work, and may also have changed the resource
         'finish.
         If autInfo(i).bAddWorkDirty Or autInfo(i).bETCDirty Then
            nETC = autInfo(i).nETC
            nWrk = autInfo(i).nAddWork
            nActWork = autInfo(i).nActWork + autInfo(i).nAddWork
            nAddWork = autInfo(i).nAddWork
            dtResFinish = autInfo(i).dtFinish

            If nWrk >= 0 And nETC > 0 Then
               ' user can't change finish date if ETC > 0
               bResult = UpdateResourceWork(oTAssign, nTID, nAUID, nActWork, nAddWork, nETC, dtAsOf)
            ElseIf nWrk >= 0 And nETC = 0 Then
               'If autInfo(i).bFinishDirty Then
                  ' update work, then update the finish
                  bResult = UpdateResourceWork(oTAssign, nTID, nAUID, nActWork, nAddWork, nETC, dtAsOf)
                  bResult = UpdateResourceFinish(oTAssign, nTID, nAUID, nActWork, dtResFinish)
               'Else
                  ' user didn't change finish, so just update work
                  'bResult = UpdateResourceWork(oTAssign, nTID, nAUID, nActWork, nAddWork, nETC, dtAsOf)
               'End If
            End If

         End If

      ' Set the task % complete = % work complete.
      goActiveProj.Tasks(nTID).PercentComplete = goActiveProj.Tasks(nTID).PercentWorkComplete

      Next i

   End If

   Screen.MousePointer = DEFAULT

Exit Sub

DoResUpdateError:
   
   Screen.MousePointer = DEFAULT
   Beep
   TerminateApplication

End Sub

' Sets the delay on the assignment identified by the task id (TID) and the
'unique assignment id (AUID) in the project referred to by oProj.
'Returns True if successful, False if not.
'
Function SetResDelay (oTAssign As Object, nTID As Integer, nAUID As Integer, nDelay As Integer) As Integer

   Dim oTask As Object        ' The current task referred to by nTID.
   Dim dtActStart As Variant  ' Actual Start for oTask.
   Dim nPctCmplt As Integer   ' The % complete value for oTask.
   
   On Error GoTo SetResDelayError

   Set oTask = goActiveProj.Tasks(nTID)
   ' If the task is in progress, we need to set act. start to
   'NA before we can enter delay on a resource.
   dtActStart = oTask.ActualStart
   If IsDate(dtActStart) Then
      nPctCmplt = oTask.PercentComplete
      oTask.ActualStart = "NA"
      oTAssign(nAUID).Delay = nDelay
      ' Restore the orig. %cmplt and act. start
      oTask.ActualStart = dtActStart
      oTask.PercentComplete = nPctCmplt
   Else
      oTAssign(nAUID).Delay = nDelay
   End If
   SetResDelay = True

   Exit Function

SetResDelayError:

   SetResDelay = False
   Exit Function

End Function

'  Adjusts resource assignment units as necessary to maintain the Start and
'Finish dates entered by the user.  This function assumes that remaining work
'is Zero (i.e., the resource is done with it's work on this task).
'
' nTID - ID of the task that the resource is assigned to
' nAUID - Unique assignment ID of the resource on the task nTID
' nActWork - The total amount of work (in minutes) done on the task by the resource.
' dtFinish - The finish date entered by the user.
'
' UpdateResourceFinish returns True if successful, False if an error occurs.
'
Function UpdateResourceFinish (oTAssign As Object, nTID As Integer, nAUID As Integer, ByVal nActWork As Integer, dtFinish As Variant) As Integer

   Dim oApp As Object               ' Application object.
   Dim oProj As Object              ' Active project object.
   Dim oAssignment As Object        ' Assignment object
   Dim oCal As Object               ' Resource calendar object.
   Dim dtResStart As Variant        ' The resource start date on oAssignment.
   Dim nDur As Integer              ' The working duration between the resource Start and Finish dates.
   Dim fResUnits As Single          ' The resource assignment units.
   Dim nRID As Integer              ' the resource ID
   Dim nOvertime As Integer         ' Overtime work for the resource.
   Dim dtStart As Variant           ' The start date of the resource on the task.
   Dim nNewOvertime As Integer          ' Ovt. work for the resource plus any existing ovt. work on the task for this resource.
   Dim nExistingOvertime As Integer     ' Previous ovt. work on the task by the current resource.
   
   
   On Error GoTo UpdateResourceFinishError

   Set oApp = goProjApp
   Set oProj = goActiveProj
   Set oAssignment = oTAssign(nAUID)

   ' Get the assignment start date.
   dtStart = oAssignment.Start

   ' Get the calendar object for the current resource.
   nRID = oAssignment.ResourceID
   Set oCal = oProj.Resources(nRID).Calendar

   ' Calc the available working duration between the current start and new finish dates.
   nDur = oApp.DateDifference(dtStart, dtFinish, oCal)

   ' If the actual work is greater than the available duration, put the excess work
   'into overtime.
   If nActWork > nDur Then
      nOvertime = nActWork - nDur
      nExistingOvertime = oAssignment.OvertimeWork
      If nOvertime > nExistingOvertime Then
         nNewOvertime = nOvertime
      Else
         nNewOvertime = nExistingOvertime
      End If
      fResUnits = 1                    ' Set resource units to 1.0
   Else
      ' In this case, actual work is less than the amount of work that could have been done
      'between the start/finish dates, so we need to adjust the resource units to keep the
      'new dates.
      fResUnits = CSng(Format(nActWork / nDur, "0.00"))
      nOvertime = 0
   End If
   
   ' Change the resource assignment units.
   oAssignment.Units = fResUnits
   ' Enter the actual work.
   oAssignment.ActualWork = nActWork
   ' Enter the overtime work.
   oAssignment.OvertimeWork = nNewOvertime

   UpdateResourceFinish = True

   
Exit Function

UpdateResourceFinishError:
   
   UpdateResourceFinish = False
   Exit Function

End Function

'  If the resource's start date is earlier than the task start we will
'enter this in as the task start and enter in delay for all of the other
'resources so that their start dates remain the same.  If the resource's
'start date is later than the task start then we will enter in delay for the
'resource.  If all of the resources have delay we will reset the task start
'date to the earliest starting resource and adjust the delays of all of the
'other resources so that their starts are correct.
'
'nTID - ID of task whose resource start we're modifying
'nAUID - unique assignment ID of the resource to modify
'dtResStart - new start for the resource indicated by nAUID
'
Function UpdateResourceStart (oTAssign As Object, nTID As Integer, nAUID As Integer, dtResStart As Variant) As Integer

   Dim oAssignment As Object                    ' Current task object.
   Dim oTemp As Object                    ' temp object
   Dim dtTaskStart As Variant             ' Start date of current task.
   ReDim vntAssign(1, 0) As Variant       ' Used to store the resource id and Start for the resources in oTAssign.
   Dim nTmpAUID As Integer                ' Holds a AUID for reuse in a loop.
   Dim nDelay As Integer                  ' The Delay needed to establish a res start date.
   Dim bRtn As Integer                    ' Holds a return value from a function.
   Dim i As Integer                       ' Loop counter.
   Dim bDelayOnAll As Integer             ' True if all the resources in oTAssign have delay.
   Dim j As Integer, Min  As Variant      ' Used in the sort routine.
   Dim nRID As Integer

   On Error GoTo UpdateResourceStartError

   Set oAssignment = oTAssign(nAUID)

   ' Get the current start date for the task.
   dtTaskStart = goActiveProj.Tasks(nTID).Start

   Select Case DateDiff("n", dtTaskStart, dtResStart)
      Case Is = 0    'Task start and resource start are the same.

         ' Set the res start date.
         oAssignment.ActualStart = dtResStart

      Case Is < 0  ' Resource start is earlier than the task start.

         ' Check to see if there are other resources assigned to the task.
         If oTAssign > 1 Then
            ' Loop through the assignments.
            For i = 1 To oTAssign.Count
               ' For each assigment (except the AUID we're updating) save
               'the AUID and Start.
               Set oTemp = oTAssign(i)
               nRID = oTemp.ResourceID
               nTmpAUID = AIndex(oTAssign, nTID, nRID)
               If nTmpAUID <> nAUID Then
                  ReDim Preserve vntAssign(1, i) As Variant
                  vntAssign(0, i) = nTmpAUID
                  vntAssign(1, i) = oTemp.Start
               End If
            Next i
            ' Change the task and res start.
            goActiveProj.Tasks(nTID).ActualStart = dtResStart
            'oAssignment.Start = dtResStart
            ' Now go back and add the amount of delay needed to retain
            'the current start dates for all the other resources.
            For i = 1 To UBound(vntAssign, 2)
               nDelay = goProjApp.DateDifference(dtResStart, vntAssign(1, i))
               bRtn = SetResDelay(oTAssign, nTID, CInt(vntAssign(0, i)), nDelay)
            Next i
         Else

            If oAssignment.Delay > 0 Then oAssignment.Delay = 0
            goActiveProj.Tasks(nTID).ActualStart = dtResStart
            'oAssignment.Start = dtResStart
         End If

      Case Is > 0   'Resource starts after the task start.

         ' Check to see if there are other resources assigned to the task.
         If oTAssign > 1 Then
            nDelay = goProjApp.DateDifference(dtTaskStart, dtResStart)
            bRtn = SetResDelay(oTAssign, nTID, nAUID, nDelay)
            ' Check to see if all the resources have delay.
            bDelayOnAll = True
            For i = 1 To oTAssign.Count
               Set oTemp = oTAssign(i)
               If oTemp.Delay > 0 Then
                  ReDim Preserve vntAssign(1, i) As Variant
                  nRID = oTemp.ResourceID
                  vntAssign(0, i) = AIndex(oTAssign, nTID, nRID)
                  vntAssign(1, i) = oTemp.Start
               Else
                  bDelayOnAll = False
                  Exit For
               End If
            Next i
            If bDelayOnAll Then
               ' Search the res starts to find the earliest start.  '####
               j = 2
               Min = vntAssign(1, 1)
               While j < UBound(vntAssign, 2)
                  If vntAssign(1, j) < Min Then
                     Min = vntAssign(1, j)
                  End If
                  j = j + 1
               Wend
               ' Set the task start = the earliest resource start
               goActiveProj.Tasks(nTID).ActualStart = Min
               ' Set the appropriate delay for all the other resources to
               'keep their current start dates.
               For i = 1 To UBound(vntAssign, 2)
                  nDelay = goProjApp.DateDifference(Min, vntAssign(1, i))
                  bRtn = SetResDelay(oTAssign, nTID, CInt(vntAssign(0, i)), nDelay)
               Next i
            End If
         Else
            ' No other resources, so just change the dates.
            goActiveProj.Tasks(nTID).ActualStart = dtResStart
            'oAssignment.Start = dtResStart
         End If

   End Select

   UpdateResourceStart = True

   
Exit Function

UpdateResourceStartError:

   UpdateResourceStart = False
   Exit Function

End Function

' Adjusts the task finish date based on the As Of date and the remaining work.
'
'  nTID - Task ID
'  nAUD - Unique assignment ID of the resource on task nTID
'  nActWork - The total work (in minutes) done by the resource on the task.  Declared
'ByVal because this function may modify nActWork.
'  nRemWork - The estimate of the remaining work (in minutes) that is to be done by the
'resource.
'  dtAsOf - The "As Of" update date.
'
' UpdateResourceWork returns True if successful, False if an error occurs.
'
Function UpdateResourceWork (oTAssign As Object, nTID As Integer, nAUID As Integer, ByVal nActWork As Integer, nAddWork As Integer, nRemWork As Integer, dtAsOf As Variant) As Integer

   Dim oApp As Object               ' Current application object.
   Dim oProj As Object              ' Current active project object.
   Dim oAssignment As Object        ' Current assignment
   Dim oTemp As Object              ' temp object
   Dim oCal As Object               ' Resource calendar object
   Dim dtNewFinish As Variant       ' New resource finish date.
   Dim dtCurFinish As Variant       ' Current task finish date.
   Dim i As Integer                 ' Loop counter.
   ReDim fAssign(1, 0) As Single    ' Holds RID and Remaining Work for each
                                    'of the resources in oTAssign.
   Dim nOvertime As Integer         ' Excess work for the resource.
   Dim dtResStart As Variant        ' The resource start date.
   Dim j As Integer, k As Integer, Tmp As Single, Min As Integer  ' Used in the sort routine.
   Dim nDur As Integer              ' Working duration between dtResStart and dtNewFinish.
   Dim nNewOvertime As Integer
   Dim nExistingOvertime As Integer
   Dim nRID As Integer

   On Error GoTo UpdateResourceWorkError

   Set oApp = goProjApp
   Set oProj = goActiveProj
   Set oAssignment = oTAssign(nAUID)
   nRID = oAssignment.ResourceID
   Set oCal = oProj.Resources(nRID).Calendar
    
    oAssignment.RemainingWork = nRemWork

   ' Calculate the resource's new finish date based on the As Of date
   'and the remaining work (ETC).
   If nRemWork > 0 And CVDate(dtAsOf) >= oApp.DateAdd(oAssignment.Start, nActWork) Then
      dtNewFinish = oApp.DateAdd(dtAsOf, nRemWork, oCal)
   Else
      dtNewFinish = oAssignment.Finish
   End If

   ' Get the resource's current start date.
   dtResStart = oAssignment.Start

   ' Get the difference in working duration between dtResStart and dtNewFinish
   nDur = oApp.DateDifference(dtResStart, dtNewFinish, oCal)
   ' Put excess work into overtime
   If nAddWork > nDur Then
      nOvertime = nAddWork - nDur
   End If
   nExistingOvertime = oAssignment.OvertimeWork
   If nOvertime > nExistingOvertime Then
      nNewOvertime = nOvertime
   Else
      nNewOvertime = nExistingOvertime
   End If
   

   ' Get the current finish date for the task.
   dtCurFinish = oProj.Tasks(nTID).Finish

   Select Case dtNewFinish

      ' Calculate back from dtNewFinish by the amount of remaining work
      'of the resource with the most remaining work and set the Resume
      'No Earlier Than (RNET) field to this date.  This will cause the
      'task's finish to be equal to dtNewFinish.
      Case Is > dtCurFinish
         ' Find the resource with the most remaining work.
         If oTAssign > 1 Then
            For i = 1 To oTAssign.Count
            Set oTemp = oTAssign(i)
               ReDim Preserve fAssign(1, i) As Single
               fAssign(0, i) = oTemp.UniqueID
               fAssign(1, i) = oTemp.RemainingWork
            Next i

            ' Add the current resource to the array
            ReDim Preserve fAssign(1, i + 1) As Single
            fAssign(0, i + 1) = nAUID
            fAssign(1, i + 1) = nRemWork

            Tmp = 0
            For j = 1 To UBound(fAssign, 2)
               If fAssign(1, j) > Tmp Then Tmp = fAssign(1, j)
            Next

            ' Calculate back from dtNewFinish by the greatest amount
            'of remaining work.
            oProj.Tasks(nTID).ResumeNoEarlierThan = oApp.DateSubtract(dtNewFinish, Tmp)
         Else
            ' No other resources, so use the dtNewFinish as the
            'RNET date.
            oProj.Tasks(nTID).ResumeNoEarlierThan = oApp.DateSubtract(dtNewFinish, nRemWork)
         End If
         oAssignment.ActualWork = nActWork
         'oAssignment.OvertimeWork = nNewOvertime
         oAssignment.Work = nActWork + nRemWork
         
      ' Enter the updated info and let Winproj calculate the task finish.
      Case Is <= dtCurFinish
         oAssignment.ActualWork = nActWork
         'oAssignment.OvertimeWork = nNewOvertime
         oAssignment.Work = nActWork + nRemWork

   End Select
   
   UpdateResourceWork = True

Exit Function

UpdateResourceWorkError:
   
   UpdateResourceWork = False
   Exit Function

End Function

